home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lib / explain.pl < prev    next >
Encoding:
Text File  |  1998-02-18  |  7.4 KB  |  252 lines
  1. /*  $Id: explain.pl,v 1.6 1998/02/18 13:56:36 jan Exp $
  2.  
  3.     Part of SWI-Prolog
  4.     Designed and implemented by Jan Wielemaker
  5.     E-mail: jan@swi.psy.uva.nl
  6.  
  7.     Copyright (C) 1996 University of Amsterdam. All rights reserved.
  8. */
  9.  
  10. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  11. The   library(explain)   describes   prolog-terms.   The   most   useful
  12. functionality is its cross-referencing function.
  13.  
  14. Note  that  the  help-tool  for   XPCE    provides   a   nice  graphical
  15. cross-referencer.
  16. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  17.  
  18. :- module(explain,
  19.       [ explain/1,
  20.         explain/2
  21.       ]).
  22. :- use_module(library(helpidx)).
  23.  
  24. explain(Item) :-
  25.     explain(Item, Explanation),
  26.     write_ln(Explanation),
  27.     fail.
  28. explain(_).
  29.  
  30.         /********************************
  31.         *           BASIC TYPES         *
  32.         *********************************/
  33.  
  34. explain(Var, Explanation) :-
  35.     var(Var), !,
  36.     utter(Explanation, '"~w" is an unbound variable', [Var]).
  37. explain(I, Explanation) :-
  38.     integer(I), !,
  39.     utter(Explanation, '"~w" is an integer', [I]).
  40. explain(F, Explanation) :-
  41.     float(F), !,
  42.     utter(Explanation, '"~w" is a floating point number', [F]).
  43. explain(S, Explanation) :-
  44.     string(S), !,
  45.     utter(Explanation, '"~w" is a string', S).
  46. explain([], Explanation) :- !,
  47.     utter(Explanation, '"[]" is an atom denoting an empty list', []).
  48. explain(A, Explanation) :-
  49.     atom(A),
  50.     utter(Explanation, '"~w" is an atom', [A]).
  51. explain(A, Explanation) :-
  52.     current_op(Pri, F, A),
  53.     op_type(F, Type),
  54.     utter(Explanation, '"~w" is a ~w (~w) operator of priority ~d',
  55.           [A, Type, F, Pri]).
  56. explain(A, Explanation) :-
  57.     atom(A), !,
  58.     explain_atom(A, Explanation).
  59. explain([H|T], Explanation) :-
  60.     proper_list(T), !,
  61.     List = [H|T],
  62.     length(List, L),
  63.     (   utter(Explanation, '"~p" is a proper list with ~d elements',
  64.               [List, L])
  65.     ;   checklist(printable, List),
  66.         utter(Explanation, '~t~8|Text is "~s"',  [List])
  67.     ).
  68. explain([H|T], Explanation) :- !,
  69.     length([H|T], L), !,
  70.     utter(Explanation, '"~p" is a not-closed list with ~d elements',
  71.           [[H|T], L]).
  72. explain(Name/Arity, Explanation) :-
  73.     atom(Name),
  74.     integer(Arity), !,
  75.     functor(Head, Name, Arity),
  76.     current_predicate(_, Module:Head),
  77.     (   Module == system
  78.     ->  true
  79.     ;   \+ predicate_property(Module:Head, imported_from(_))
  80.     ),
  81.     explain_predicate(Module:Head, Explanation).
  82. explain(Term, Explanation) :-
  83.     utter(Explanation, '"~w" is a compound term', [Term]).
  84. explain(Term, Explanation) :-
  85.     explain_functor(Term, Explanation).
  86.     
  87. op_type(X, prefix) :-
  88.     atom_chars(X, [0'f, _]).
  89. op_type(X, infix) :-
  90.     atom_chars(X, [_, 0'f, _]).
  91. op_type(X, postfix) :-
  92.     atom_chars(X, [_, 0'f]).
  93.  
  94. printable(C) :-
  95.     integer(C),
  96.     between(32, 126, C).
  97.  
  98.         /********************************
  99.         *             ATOMS             *
  100.         *********************************/
  101.  
  102. explain_atom(A, Explanation) :-
  103.     referenced(A, Explanation).
  104. explain_atom(A, Explanation) :-
  105.     current_predicate(A, Module:Head),
  106.     (   Module == system
  107.     ->  true
  108.     ;   \+ predicate_property(Module:Head, imported_from(_))
  109.     ),
  110.     explain_predicate(Module:Head, Explanation).
  111.  
  112.         /********************************
  113.         *            FUNCTOR             *
  114.         *********************************/
  115.  
  116. explain_functor(Head, Explanation) :-
  117.     referenced(Head, Explanation).
  118. explain_functor(Head, Explanation) :-
  119.     current_predicate(_, Module:Head),
  120.     \+ predicate_property(Module:Head, imported_from(_)),
  121.     explain_predicate(Module:Head, Explanation).
  122. explain_functor(Head, Explanation) :-
  123.     predicate_property(M:Head, undefined),
  124.     (   functor(Head, N, A),
  125.         utter(Explanation, '~w:~w/~d is an undefined predicate', [M,N,A])
  126.     ;   referenced(M:Head, Explanation)
  127.     ).
  128.     
  129.     
  130.         /********************************
  131.         *           PREDICATE           *
  132.         *********************************/
  133.  
  134. lproperty(built_in,    ' built-in', []).
  135. lproperty(dynamic,    ' dynamic', []).
  136. lproperty(multifile,    ' multifile', []).
  137. lproperty(transparent,    ' meta', []).
  138.  
  139. tproperty(imported_from(Module), ' imported from module ~w', [Module]).
  140. tproperty(file(File),        ' defined in~n~t~8|~w', [File]).
  141. tproperty(line_count(Number),    ':~d', [Number]).
  142.  
  143. combine_utterances(Pairs, Explanation) :-
  144.     maplist(first, Pairs, Fmts),
  145.     concat_atom(Fmts, Format),
  146.     maplist(second, Pairs, ArgList),
  147.     flatten(ArgList, Args),
  148.     utter(Explanation, Format, Args).
  149.  
  150. first(A-_B, A).
  151. second(_A-B, B).
  152.  
  153. explain_predicate(Pred, Explanation) :-
  154.     Pred = Module:Head,
  155.     functor(Head, Name, Arity),
  156.     
  157.     U0 = '~w:~w/~d is a' - [Module, Name, Arity],
  158.     findall(Fmt-Arg, (lproperty(Prop, Fmt, Arg),
  159.               predicate_property(Pred, Prop)),
  160.         U1),
  161.      U2 = ' predicate' - [],
  162.     findall(Fmt-Arg, (tproperty(Prop, Fmt, Arg),
  163.               predicate_property(Pred, Prop)),
  164.         U3),
  165.     flatten([U0, U1, U2, U3], Utters),
  166.     combine_utterances(Utters, Explanation).
  167. explain_predicate(Pred, Explanation) :-
  168.     predicate_property(Pred, built_in),
  169.     Pred = _Module:Head,
  170.     functor(Head, Name, Arity),
  171.     predicate(Name, Arity, Summary, _, _),
  172.     utter(Explanation, '~t~8|Summary: ``~w''''', [Summary]).
  173. explain_predicate(Pred, Explanation) :-
  174.     referenced(Pred, Explanation).
  175.     
  176.         /********************************
  177.         *          REFERENCES           *
  178.         *********************************/
  179.  
  180. referenced(Term, Explanation) :-
  181.     current_predicate(_, Module:Head),
  182.     \+ predicate_property(Module:Head, built_in),
  183.     \+ predicate_property(Module:Head, imported_from(_)),
  184.     Module:Head \= help_index:predicate(_,_,_,_,_),
  185.     Head \= '$user_query'(_,_),
  186.     nth_clause(Module:Head, N, Ref),
  187.     '$xr_member'(Ref, Term),
  188.     utter_referenced(Module:Head, N, Ref,
  189.              'Referenced', Explanation).
  190.  
  191. referenced(_Module:Head, Explanation) :-
  192.     current_predicate(_, Module:Head),
  193.     \+ predicate_property(Module:Head, built_in),
  194.     \+ predicate_property(Module:Head, imported_from(_)),
  195.     nth_clause(Module:Head, N, Ref),
  196.     '$xr_member'(Ref, Head),
  197.     utter_referenced(Module:Head, N, Ref,
  198.              'Possibly referenced', Explanation).
  199.  
  200. utter_referenced(_Module:class(_,_,_,_,_,_), _, _, _, _) :-
  201.     feature(xpce, true), !,
  202.     fail.
  203. utter_referenced(_Module:lazy_send_method(_,_,_), _, _, _, _) :-
  204.     feature(xpce, true), !,
  205.     fail.
  206. utter_referenced(_Module:lazy_get_method(_,_,_), _, _, _, _) :-
  207.     feature(xpce, true), !,
  208.     fail.
  209. utter_referenced(Module:Head, _N, Ref, Text, Explanation) :-
  210.     feature(xpce, true),
  211.     functor(Head, Name, _Arity),
  212.     concat(send_, Class, Name),
  213.     selector(Ref, Selector),
  214.     check_xpce_method(Module, Class, send, Selector), !,
  215.     utter(Explanation,
  216.           '~t~8|~w from ~w->~w',
  217.           [Text, Class, Selector]).
  218. utter_referenced(Module:Head, _N, Ref, Text, Explanation) :-
  219.     feature(xpce, true),
  220.     functor(Head, Name, _Arity),
  221.     concat(get_, Class, Name),
  222.     selector(Ref, Selector),
  223.     check_xpce_method(Module, Class, get, Selector), !,
  224.     utter(Explanation,
  225.           '~t~8|~w from ~w<-~w',
  226.           [Text, Class, Selector]).
  227. utter_referenced(Module:Head, N, _Ref, Text, Explanation) :-
  228.     functor(Head, Name, Arity),
  229.     utter(Explanation,
  230.           '~t~8|~w from ~d-th clause of ~w:~w/~d',
  231.           [Text, N, Module, Name, Arity]).
  232.     
  233. selector(Ref, Selector) :-
  234.     clause(Head, _Body, Ref),
  235.     '$strip_module'(Head, _, Plain),
  236.     arg(1, Plain, Selector),
  237.     atom(Selector).
  238.  
  239. %    Verifies the detection of a clause implementing an XCE method.
  240.  
  241. check_xpce_method(Module, Class, send, Selector) :-
  242.     catch(Module:lazy_send_method(Selector, Class, _), _, fail).
  243. check_xpce_method(Module, Class, get, Selector) :-
  244.     catch(Module:lazy_get_method(Selector, Class, _), _, fail).
  245.  
  246.         /********************************
  247.         *             UTTER            *
  248.         *********************************/
  249.  
  250. utter(Explanation, Fmt, Args) :-
  251.     sformat(Explanation, Fmt, Args).
  252.